Estudo do Pacote Flexmix
1 O pacote
O trabalho desenvolvido teve como objetivo estudar o pacote Flexmix e compara-lo com demais técnicas de clusterização.
O pacote trás como sua principal funcionalidade a capacidade de ajustar diferentes distribuições para as misturas, se caracterizando como um framework de misturas de modelos lineares generalizados, semi paramétrico e não paramétrico
O pacote já está disponível no cran, através de https://cran.r-project.org/web/packages/flexmix/index.html
O autor também oferece diversos artigos em forma de vignetes
2 Aplicação em Dados Reais
A primeira etapa do trabalho se baseia na aplicação de diferentes métodos de agrupamento
Os dados utilizados foram retirados do e se referem a medidas de pinguins adultos perto da Estação Palmer, Antártida (Palmer Station)
df_pengu = palmerpenguins::penguins %>%
filter(complete.cases(.)) |>
select(-year)
df_pengu |>
rmarkdown::paged_table()O conjunto de dados possui as seguintes variáveis
- species
- Um fator com as espécies de pinguim (Adelie, Gentoo e Chinstrap)
- island
- Um fator com cada ilha do Arquipélago Palmer, na Antártida (Biscoe, Dream, Togersen)
- bill_length_mm
- Um número inteiro que indica o comprimento do bico (em milímetros)
- bill_depth_mm
- Um número inteiro que indica a profundidade do bico (em milímetros)
- flipper_length_mm
- Um número inteiro que indica o comprimento da nadadeira (em milímetros)
- body_mass_g
- Um número inteiro que indica a massa corporal (em gramas)
- sex
- Um fator que indica o sexo do(a) pinguim (macho, fêmea)
As 3 variáveis categóricas podem se mostrar de interesse para construção de grupos
df_pengu |>
group_by(
across(
where(is.factor)
)
) |>
summarise(
across(
where(is.numeric),
~mean(.)
)
) |>
rmarkdown::paged_table()`summarise()` has grouped output by 'species', 'island'. You can override using
the `.groups` argument.
df_pengu |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
ungroup() |>
mutate(species_sex = glue::glue("{species}_{sex}") |>
as.character(),
.keep = 'unused') |>
ggplot(aes(x = species_sex, y = value, fill = species_sex)) +
geom_violin(drop = F) +
facet_wrap(~name, scales = 'free') +
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank())Vemos que a variável de espécie e sexo são aquelas a apresentarem maiores divisões entre os pinguins e assim desejamos ver que essa separação seja capturada pelos algoritmos de agrupamento
É importante destacar que tais variáveis categóricas serão ‘escondidas’ para algoritmos de agrupamento.
3 diferentes algoritmos foram utilizados: AGNES, K-Means e Modelos de Misturas
2.1 AGNES
AGNES(AGglomerative NESting) é um método de agrupamento hierárquico aglomerativo.
df_pengu_scl_num = df_pengu |>
select(
where(is.numeric)
) |>
mutate(
across(
where(is.numeric),
~scale(.)
)
)
agnes_cluter = df_pengu_scl_num |>
factoextra::get_dist() |>
hclust(method = 'complete')fviz_nbclust(df_pengu_scl_num, FUN = hcut, method = "wss")fviz_nbclust(df_pengu_scl_num, FUN = hcut, method = "silhouette")fviz_nbclust(df_pengu_scl_num, FUN = hcut, method = "gap_stat")plot(agnes_cluter)
rect.hclust(agnes_cluter, k=5)fviz_cluster(
list(data = df_pengu_scl_num,
cluster = cutree(agnes_cluter, k = 5)),
ellipse = TRUE,
ellipse.type = "norm"
)2.2 K-Means
A clusterização via K-means (MacQueen 1967) é um dos algoritmos de aprendizado de máquina não supervisionado mais comumente usados para particionar um determinado conjunto de dados em um conjunto de k grupos (ou seja, k clusters), onde k representa o número de grupos pré-especificados pelo analista.
Assim como no método hierárquico, foi definido um número de grupos igual a 5
kmeans_cluter = df_pengu_scl_num |>
kmeans(centers = 5, nstart = 35)fviz_cluster(kmeans_cluter,
data = df_pengu_scl_num,
ellipse = TRUE,
ellipse.type = "norm"
)2.3 Misturas
Para a aplicação de modelos de misturas, o pacote flexmix, já introduzido, foi utilizado
O algoritmo se mostrou extremamente inconsistente, com diferentes resultados a cada execução
df_pengu_scl_num %>%
flexmix::flexmix(bill_length_mm + bill_depth_mm +
flipper_length_mm + body_mass_g ~ 1, data = ., k = 5)
Call:
flexmix::flexmix(formula = bill_length_mm + bill_depth_mm + flipper_length_mm +
body_mass_g ~ 1, data = ., k = 5)
Cluster sizes:
1 2 3 4 5
105 111 1 108 8
no convergence after 200 iterations
df_pengu_scl_num %>%
flexmix::flexmix(bill_length_mm + bill_depth_mm +
flipper_length_mm + body_mass_g ~ 1, data = ., k = 5)
Call:
flexmix::flexmix(formula = bill_length_mm + bill_depth_mm + flipper_length_mm +
body_mass_g ~ 1, data = ., k = 5)
Cluster sizes:
1 2 3 4 5
0 94 133 0 106
no convergence after 200 iterations
df_pengu_scl_num %>%
flexmix::flexmix(bill_length_mm + bill_depth_mm +
flipper_length_mm + body_mass_g ~ 1, data = ., k = 5)
Call:
flexmix::flexmix(formula = bill_length_mm + bill_depth_mm + flipper_length_mm +
body_mass_g ~ 1, data = ., k = 5)
Cluster sizes:
1 2 3 4 5
96 113 0 0 124
convergence after 183 iterations
É possível a execução da função resultou em grandes diferenças no tamanho de cada grupo quando essa convergia, e em certos casos o algoritmo não convergiu após 200 iterações. Vale destacar que a função não possui um argumento para definção do número máximo de iterações.
3 Etapa de Simulação
A segunda etapa do trabalho buscou estudar a capacidade de agrupamento do algoritmo utilizado no pacote via estudo de simulação
Estudos de grupos menos e mais semelhantes entre si foi realizado, onde para isso foram definidos 3 simulações bases
- Grupos diferentes apenas na média
- Foram simulados grupos que se diferem em 10, 5, e 1 unidade de média, com o desvio-padrão fixado em 1
mix_mean_change =
list(near =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 1, sd = 1),
c3 = rnorm(100, mean = 2, sd = 1)),
between =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 5, sd = 1),
c3 = rnorm(100, mean = 10, sd = 1)),
far =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 10, sd = 1),
c3 = rnorm(100, mean = 20, sd = 1))
)mix_mean_change |>
as.data.frame() |>
tidyr::pivot_longer(where(is.numeric)) |>
dplyr::mutate(name = name |>
stringr::str_remove_all("\\..*$")) |>
ggplot(aes(x = value, fill = name)) +
geom_histogram() +
facet_wrap(~name, ncol = 1, scales = 'free')`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
- Grupos diferentes apenas no desvio-padrão
- Foram simulados grupos que se diferem em 10, 5, e 1 unidade de desvio-padrão, com a média fixada em 0
mix_sd_change =
list(near =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 0, sd = 2),
c3 = rnorm(100, mean = 0, sd = 3)),
between =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 0, sd = 5),
c3 = rnorm(100, mean = 0, sd = 10)),
far =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 0, sd = 10),
c3 = rnorm(100, mean = 0, sd = 20))
)mix_sd_change |>
as.data.frame() |>
tidyr::pivot_longer(where(is.numeric)) |>
dplyr::mutate(name = name |>
stringr::str_remove_all("\\..*$")) |>
ggplot(aes(x = value, fill = name)) +
geom_histogram() +
facet_wrap(~name, ncol = 1, scales = 'free')`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
- Grupos diferentes em média e desvio-padrão
- Foram simulados grupos que se diferem em 5, e 1 unidade de média e desvio-padrão. Buscando a complexidade do trabalho, as seguintes combinações foram realizadas
- 1 unidades de distância na média
- 1, 2 e 5 unidades de distância no desvio padrão
- 3 unidades de distância na média
- 1, 2 e 5 unidades de distância no desvio padrão
mix_mean_sd_change1 =
list(near =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 3, sd = 2),
c3 = rnorm(100, mean = 6, sd = 3)),
between =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 3, sd = 3),
c3 = rnorm(100, mean = 6, sd = 5)),
far =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 3, sd = 5),
c3 = rnorm(100, mean = 6, sd = 10))
)
mix_mean_sd_change2 =
list(near =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 1, sd = 2),
c3 = rnorm(100, mean = 2, sd = 3)),
between =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 1, sd = 3),
c3 = rnorm(100, mean = 2, sd = 5)),
far =
tibble::tibble(
c1 = rnorm(100, mean = 0, sd = 1),
c2 = rnorm(100, mean = 1, sd = 5),
c3 = rnorm(100, mean = 2, sd = 10))
)mix_mean_sd_change1 |>
as.data.frame() |>
tidyr::pivot_longer(where(is.numeric)) |>
dplyr::mutate(name = name |>
stringr::str_remove_all("\\..*$")) |>
ggplot(aes(x = value, fill = name)) +
geom_histogram() +
facet_wrap(~name, ncol = 1, scales = 'free')`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
mix_mean_sd_change2 |>
as.data.frame() |>
tidyr::pivot_longer(where(is.numeric)) |>
dplyr::mutate(name = name |>
stringr::str_remove_all("\\..*$")) |>
ggplot(aes(x = value, fill = name)) +
geom_histogram() +
facet_wrap(~name, ncol = 1, scales = 'free')`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Para os 3 casos, foram simulados grupos a partir de uma distribuição Normal com tamanho amostral 300.
3.1 AGNES
3.1.1 Variando a Média
Primeiramente o algoritmo foi aplicado nos grupos com seperação de 10 unidade na média
agnes_far_cluster = mix_mean_change$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)A segunda etapa foi a aplicação do método nos dados com grupos se distanciando em 5 unidades na média
agnes_between_cluster = mix_mean_change$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)A útlima etapa foi aplicação do método nos dados que possuiam os grupos mais próximos, com apenas 1 unidade de distancia na média
agnes_near_cluster = mix_mean_change$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)3.1.2 Variando o Desvio Padrão
agnes_far_cluster = mix_sd_change$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)agnes_between_cluster = mix_sd_change$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)agnes_near_cluster = mix_sd_change$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)3.1.3 Variando a Média e o Desvio Padrão
agnes_far_cluster = mix_mean_sd_change1$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)agnes_between_cluster = mix_mean_sd_change1$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)agnes_near_cluster = mix_mean_sd_change1$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)agnes_far_cluster = mix_mean_sd_change2$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)agnes_between_cluster = mix_mean_sd_change2$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)agnes_near_cluster = mix_mean_sd_change2$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
factoextra::get_dist() |>
hclust(method = 'complete')
plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)3.2 K-Means
3.2.1 Variando a Média
kmeans_far_cluster = mix_mean_change$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)mix_mean_change$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
mutate(fitted = kmeans_far_cluster$cluster) |>
rename(actual = name) |>
mutate(actual = actual |>
stringr::str_remove("[^0-9]") |>
as.numeric() ) |>
mutate(correct =
case_when(actual == fitted ~ T,
.default = F),
actual =
actual |>
as.character()) |>
group_by(actual) |>
summarise(media = mean(correct)) |>
ggplot(aes(x = actual, y = media, fill = actual)) +
geom_col() +
labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
theme_minimal()kmeans_between_cluster = mix_mean_change$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)
kmeans_between_clusterK-means clustering with 3 clusters of sizes 101, 99, 100
Cluster means:
[,1]
1 9.975944889
2 4.860534736
3 -0.004163329
Clustering vector:
[1] 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3
[38] 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2
[75] 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1
[112] 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3
[149] 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2
[186] 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1
[223] 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3
[260] 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 1 1 3 2 1 3 2
[297] 1 3 2 1
Within cluster sum of squares by cluster:
[1] 95.27231 84.17836 96.01847
(between_SS / total_SS = 94.8 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
mix_mean_change$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
mutate(fitted = kmeans_between_cluster$cluster) |>
rename(actual = name) |>
mutate(actual = actual |>
stringr::str_remove("[^0-9]") |>
as.numeric() ) |>
mutate(correct =
case_when(actual == fitted ~ T,
.default = F),
actual =
actual |>
as.character()) |>
group_by(actual) |>
summarise(media = mean(correct)) |>
ggplot(aes(x = actual, y = media, fill = actual)) +
geom_col() +
labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
theme_minimal()kmeans_near_cluster = mix_mean_change$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)
kmeans_near_clusterK-means clustering with 3 clusters of sizes 69, 89, 142
Cluster means:
[,1]
1 2.638624
2 -0.536972
3 1.116439
Clustering vector:
[1] 3 3 1 2 3 1 3 1 3 2 1 3 3 2 3 3 3 3 3 3 3 3 2 3 3 3 3 3 3 1 2 3 3 2 3 3 3
[38] 3 3 2 3 1 2 3 1 2 3 3 2 2 1 2 3 1 2 1 3 2 3 3 2 3 3 2 3 3 2 2 1 3 3 3 3 3
[75] 1 2 2 3 3 1 3 2 3 1 2 3 3 2 3 1 2 2 1 3 3 1 2 1 1 2 2 1 3 1 3 3 3 3 2 1 1
[112] 3 1 1 2 2 1 2 3 3 3 3 3 2 3 1 2 3 1 2 1 3 3 1 2 2 3 3 2 3 3 2 3 3 3 3 1 2
[149] 2 1 2 2 1 2 1 3 2 2 1 2 3 1 3 1 1 3 3 1 2 3 3 3 1 1 2 3 1 3 2 3 2 1 3 2 3
[186] 3 3 3 3 2 1 1 2 3 3 2 2 1 2 2 3 2 3 3 3 2 1 3 1 3 2 3 1 2 2 3 3 3 3 2 3 1
[223] 2 3 1 3 2 1 2 1 3 3 3 1 2 3 3 2 3 3 2 3 1 2 3 1 2 3 3 2 2 1 2 1 3 2 2 1 3
[260] 2 3 2 3 3 2 2 1 2 2 1 3 3 3 3 3 3 3 3 3 3 3 1 2 3 1 2 3 1 2 1 1 2 2 3 3 2
[297] 1 3 1 1
Within cluster sum of squares by cluster:
[1] 19.25048 34.68209 30.44576
(between_SS / total_SS = 82.5 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
mix_mean_change$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
mutate(fitted = kmeans_near_cluster$cluster) |>
rename(actual = name) |>
mutate(actual = actual |>
stringr::str_remove("[^0-9]") |>
as.numeric() ) |>
mutate(correct =
case_when(actual == fitted ~ T,
.default = F),
actual =
actual |>
as.character()) |>
group_by(actual) |>
summarise(media = mean(correct)) |>
ggplot(aes(x = actual, y = media, fill = actual)) +
geom_col() +
labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
theme_minimal()3.2.2 Variando o Desvio Padrão
kmeans_far_cluster = mix_sd_change$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)mix_mean_change$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
mutate(fitted = kmeans_far_cluster$cluster) |>
rename(actual = name) |>
mutate(actual = actual |>
stringr::str_remove("[^0-9]") |>
as.numeric() ) |>
mutate(correct =
case_when(actual == fitted ~ T,
.default = F),
actual =
actual |>
as.character()) |>
group_by(actual) |>
summarise(media = mean(correct)) |>
ggplot(aes(x = actual, y = media, fill = actual)) +
geom_col() +
labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
theme_minimal()kmeans_between_cluster = mix_sd_change$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)
kmeans_between_clusterK-means clustering with 3 clusters of sizes 204, 58, 38
Cluster means:
[,1]
1 -0.3789894
2 9.0984744
3 -11.3411884
Clustering vector:
[1] 1 1 3 1 1 1 1 3 2 1 1 3 1 2 3 1 3 3 1 1 1 1 2 1 1 1 1 1 1 2 1 1 2 1 1 1 1
[38] 1 1 1 2 2 1 2 2 1 1 1 1 1 1 1 3 2 1 1 1 1 2 2 1 2 3 1 1 1 1 2 2 1 1 2 1 2
[75] 3 1 1 1 1 1 2 1 1 2 1 1 2 1 1 3 1 1 1 1 1 2 1 1 3 1 2 2 1 1 1 1 1 3 1 1 2
[112] 1 3 3 1 1 3 1 1 1 1 1 2 1 1 2 1 1 3 1 1 1 1 1 2 1 3 2 1 1 2 1 1 3 1 1 1 1
[149] 1 3 1 3 2 1 1 3 1 3 2 1 2 1 1 1 2 1 1 3 1 1 1 1 3 1 1 1 3 1 1 3 1 1 2 1 1
[186] 2 1 1 1 1 2 2 1 1 3 1 3 1 1 1 1 1 2 1 1 1 2 1 1 2 1 3 1 1 1 3 1 2 1 1 1 2
[223] 1 2 1 1 3 3 1 1 2 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 2 1 1 1 1 1 2 1 3 1 1
[260] 1 2 1 2 2 1 2 2 1 1 3 1 2 2 1 3 2 1 3 2 1 1 1 1 1 1 1 1 3 1 1 1 1 1 2 1 1
[297] 1 1 1 3
Within cluster sum of squares by cluster:
[1] 1025.767 1557.041 1205.821
(between_SS / total_SS = 71.9 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
3.2.3 Variando a Média e o Desvio Padrão
kmeans_far_cluster = mix_mean_sd_change1$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)mix_mean_sd_change1$far |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
mutate(fitted = kmeans_far_cluster$cluster) |>
rename(actual = name) |>
mutate(actual = actual |>
stringr::str_remove("[^0-9]") |>
as.numeric() ) |>
mutate(correct =
case_when(actual == fitted ~ T,
.default = F),
actual =
actual |>
as.character()) |>
group_by(actual) |>
summarise(media = mean(correct)) |>
ggplot(aes(x = actual, y = media, fill = actual)) +
geom_col() +
labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
theme_minimal()kmeans_between_cluster = mix_mean_sd_change1$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)
kmeans_between_clusterK-means clustering with 3 clusters of sizes 52, 154, 94
Cluster means:
[,1]
1 9.90646106
2 -0.06857094
3 4.43597177
Clustering vector:
[1] 2 3 3 2 2 3 2 3 3 2 3 1 2 2 3 2 3 1 2 2 1 2 3 2 2 2 1 2 1 2 2 3 1 2 3 1 2
[38] 2 2 2 1 2 2 2 2 2 2 3 2 3 2 2 3 1 2 3 1 2 3 3 2 2 1 2 2 2 2 3 3 2 2 1 2 3
[75] 1 2 3 3 2 3 1 2 1 1 2 3 1 2 2 3 2 2 3 2 3 2 2 2 3 3 3 3 2 3 3 2 2 3 2 2 1
[112] 2 2 3 2 3 2 2 1 2 2 3 3 2 3 1 3 1 1 2 2 3 2 3 3 2 2 1 2 3 3 2 1 1 2 3 2 2
[149] 3 1 2 3 3 2 2 2 2 3 2 2 3 3 2 2 3 2 1 3 2 1 1 2 2 1 2 3 1 2 2 3 2 2 1 2 3
[186] 1 2 3 3 2 3 1 2 3 1 2 3 3 2 3 2 2 2 3 2 3 3 2 3 1 2 3 1 2 3 3 2 3 1 2 2 3
[223] 2 3 2 2 3 2 2 2 1 2 3 1 2 2 1 2 3 1 2 2 3 2 3 3 2 2 1 2 2 1 2 3 2 2 3 2 2
[260] 3 1 2 1 1 2 3 3 2 3 2 2 1 2 2 2 3 3 3 1 2 2 1 2 3 1 2 3 1 2 3 3 2 3 2 2 2
[297] 2 2 2 2
Within cluster sum of squares by cluster:
[1] 230.0827 293.7327 187.4806
(between_SS / total_SS = 85.3 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
mix_mean_sd_change1$between |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
mutate(fitted = kmeans_between_cluster$cluster) |>
rename(actual = name) |>
mutate(actual = actual |>
stringr::str_remove("[^0-9]") |>
as.numeric() ) |>
mutate(correct =
case_when(actual == fitted ~ T,
.default = F),
actual =
actual |>
as.character()) |>
group_by(actual) |>
summarise(media = mean(correct)) |>
ggplot(aes(x = actual, y = media, fill = actual)) +
geom_col() +
labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
theme_minimal()kmeans_near_cluster = mix_mean_sd_change1$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
dplyr::pull(value) |>
kmeans(centers = 3, nstart = 35)
kmeans_near_clusterK-means clustering with 3 clusters of sizes 51, 150, 99
Cluster means:
[,1]
1 8.483998
2 0.419360
3 4.326275
Clustering vector:
[1] 2 3 1 2 2 3 2 3 1 2 3 3 2 2 1 2 1 1 2 3 2 2 3 3 2 3 3 2 3 3 2 3 1 2 3 1 2
[38] 3 1 2 3 2 2 3 1 2 2 3 2 3 1 2 2 3 2 3 2 2 2 3 2 3 3 2 2 1 2 2 3 2 2 1 2 2
[75] 1 2 3 1 2 2 1 2 1 3 2 3 3 2 3 2 2 2 3 2 3 3 2 3 1 2 2 1 2 2 3 2 3 1 2 2 3
[112] 2 3 1 2 3 3 2 3 1 2 3 3 2 1 1 2 3 3 2 3 1 2 3 1 2 2 2 2 2 1 2 3 1 2 2 3 2
[149] 2 1 2 2 1 2 2 1 2 2 3 2 2 3 2 2 1 2 2 1 2 2 1 2 2 1 2 3 1 2 3 2 2 1 1 2 3
[186] 3 2 2 1 2 2 3 2 2 3 2 3 1 2 3 3 2 3 3 2 3 3 2 3 1 2 2 3 2 3 1 2 3 2 2 2 1
[223] 2 3 3 2 2 1 2 3 1 2 3 1 2 3 1 2 2 1 2 3 3 2 3 3 2 2 2 2 3 3 2 3 2 2 2 3 2
[260] 3 1 2 3 3 2 3 3 2 2 1 2 3 3 2 3 1 2 3 2 2 2 3 2 2 3 2 2 3 2 2 3 2 3 3 2 3
[297] 1 2 3 3
Within cluster sum of squares by cluster:
[1] 111.2805 186.9337 136.6998
(between_SS / total_SS = 86.1 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
mix_mean_sd_change1$near |>
tidyr::pivot_longer(
where(
is.numeric
)
) |>
mutate(fitted = kmeans_near_cluster$cluster) |>
rename(actual = name) |>
mutate(actual = actual |>
stringr::str_remove("[^0-9]") |>
as.numeric() ) |>
mutate(correct =
case_when(actual == fitted ~ T,
.default = F),
actual =
actual |>
as.character()) |>
group_by(actual) |>
summarise(media = mean(correct)) |>
ggplot(aes(x = actual, y = media, fill = actual)) +
geom_col() +
labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
theme_minimal()